home *** CD-ROM | disk | FTP | other *** search
/ PsL Monthly 1993 December / PSL Monthly Shareware CD-ROM (December 1993).iso / prgmming / win / vb / vbinst.exe / VBINST.BA_ / VBINST.BA
Encoding:
Text File  |  1993-03-18  |  10.1 KB  |  260 lines
  1. DefInt A-Z
  2.  
  3. 'Declaration for checking disk's free space. DLL which comes with VBINST.
  4. 'Turbo Pascal for Windows source code included.
  5. Declare Function DFree Lib "vbinst.dll" (ByVal Disk As Integer) As Long
  6.  
  7. '-------------------------------------------
  8. 'API Declarations for reading install.inf
  9. 'and detecting windows and system directory.
  10. '-------------------------------------------
  11. Declare Function GetWindowsDirectory Lib "Kernel" (ByVal WD As String, ByVal nWSize As Integer) As Integer
  12. Declare Function GetSystemDirectory Lib "Kernel" (ByVal WSD As String, ByVal nSSize As Integer) As Integer
  13. Declare Function GetPrivateProfileString Lib "Kernel" (ByVal lpApplication As String, ByVal lpKeyName As String, ByVal lpDefault As String, ByVal FileStr As String, ByVal nSize As Integer, ByVal lpFileName As String) As Integer
  14.     
  15. Global Const IDYES = 6  'define msgbox return value
  16.  
  17. Global SD As String   'source dir
  18. Global WD As String   'windows dir (see form load procedure)
  19. Global WSD As String  'windows system dir  (see form load procedure)
  20. Global WarnFlag As Integer 'flag to overwrite warning
  21.  
  22. '---------------------------------
  23. 'variables for checking diskspace.
  24. '---------------------------------
  25. Global LoadDir As String 'form load default dest dir
  26. Global DestDrive As String 'chosen drive to check free diskspace
  27.  
  28. '----------------------------------------------------
  29. 'variables for reading private ini file (install.inf)
  30. '----------------------------------------------------
  31. Global nSize As Integer
  32. Global lpFileName As String
  33. 'must use fixed-lenght variable because DLL's return
  34. Global FileStr As String * 256
  35.  
  36. 'Type for LZCopy
  37. Type OFSTRUCT
  38.   cBytes As String * 1
  39.   fFixedDisk As String * 1
  40.   nErrCode As Integer
  41.   reserved As String * 4
  42.   szPathName As String * 128
  43. End Type
  44.  
  45. 'API calls and constants for LZCopy
  46. Declare Function LZOpenFile Lib "LZexpand.dll" (ByVal lpszFile$, lpOf As OFSTRUCT, ByVal style%) As Integer
  47. Declare Function LZCopy Lib "LZexpand.dll" (ByVal hfSource%, ByVal hfDest%) As Long
  48. Declare Sub LZClose Lib "LZexpand.dll" (ByVal hfFile%)
  49. Global Const OF_CREATE = &H1000
  50. Global Const OF_READ = &H0
  51. Global Const OF_DELETE = &H200
  52. '-------------------------------------------
  53. 'variables for IniCopy and LZCopy.
  54. '-------------------------------------------
  55. Global Source As String   'source file
  56. Global Dest As String     'destination file
  57. Global DestDir As String  'destination dir for program files
  58.  
  59. Function GetSource (Arg1 As String) As String
  60.    X% = InStr(Arg1$, ",")
  61.    GetSource$ = Left$(Arg1$, X% - 1)
  62.  
  63. End Function
  64.  
  65. Sub IniCopy (lpApplication As String, lpKeyName As String, lpDefault As String, SubDir As String)
  66.     
  67. '-----------------------------------------------------------------
  68. 'This routine reads files from install.inf to be copied system
  69. 'and program directory.
  70. 'WhichDisk% and Disk% are two variables to determine correct
  71. 'disks from which to copy files. Each installation disk must have
  72. 'ID file representing that disk in istallation procedure.
  73. 'For example first installation disk must has file named 1, second
  74. 'disk must has file named 2 and so on. There is no matter what ID
  75. 'file contains, it it just identifier to installation program to
  76. 'look for correct disk at time.
  77. '-----------------------------------------------------------------
  78.     
  79.     Dim WhichDisk%, Disk%
  80.     Dim Match$
  81.     WhichDisk% = 1
  82.     
  83. '-----------------------------------------------------------------
  84. 'Next loop reads information from install.inf; files to be copied,
  85. 'and prompt for correct installtion disk's
  86. '-----------------------------------------------------------------
  87.  
  88.     I = 0
  89.     Do
  90.         I = I + 1
  91.         Screen.MousePointer = 11    'hourglass
  92.         State% = DoEvents()         'allows list files to copied to be updated
  93.         lpKeyName$ = "file" + Str$(I)
  94.         GetStringvar% = GetPrivateProfileString(lpApplication$, lpKeyName$, lpDefault$, FileStr$, nSize%, lpFileName$)
  95.  
  96. '----------------------------
  97. 'Check named mark to end loop
  98. '----------------------------
  99.  
  100.         If Left$(FileStr$, 7) = "EndMark" Then
  101.             Exit Do
  102.         ElseIf Left$(FileStr$, 8) = "EndMark" Then
  103.             Exit Do
  104.         End If
  105.         
  106. '-------------------------------------------------------
  107. 'Get installation disk number after file's name it
  108. 'reads from install.inf. For example file 5=myprog.exe,2
  109. 'where myprog.exe represents file to be istalled and
  110. 'after comma (,) 2 represents installation disk number
  111. 'from where to look for file.
  112. '-------------------------------------------------------
  113.  
  114.         Disk% = Val(Right$(Left$(FileStr$, GetStringvar%), 1))
  115.         If Disk% > WhichDisk% Then
  116.             WhichDisk% = Disk%
  117.        
  118. '------------------------------------------------------
  119. 'If installation program has reach last file from disk,
  120. 'prompt user to change new disk to source drive and do
  121. 'correct error checking.
  122. '------------------------------------------------------
  123.  
  124. WrongDisk:
  125.             MsgBox "Insert disk number " + Str$(Disk%), 64, "Another disk required!"
  126.                 
  127. '---------------------------------------------------
  128. 'Look for disk ID file to dtermine correct disk and
  129. 'get rid off leading blanks that Str$ function adds.
  130. 'If user press enter and disk is not ready, let them
  131. 'know and try again. SD$ is source drive.
  132. '---------------------------------------------------
  133.             On Error Resume Next
  134.             Match$ = Dir$(RTrim$(LTrim$(Str$(WhichDisk%))))
  135.             If Err = 71 Then
  136.                 MsgBox "There is no disk in drive " + Left$(SD$, 2), 48, "Device error"
  137.                 Err = 0
  138.                 GoTo WrongDisk
  139.             End If
  140.             If Match$ = "" Then GoTo WrongDisk
  141.             Install.Refresh
  142.         End If
  143.         
  144.         'copy all program files to destination dir
  145.         File$ = RTrim$(Left$(FileStr$, GetStringvar% - 2)) 'move spaces and disk ID from right
  146.         Source$ = SD$ + GetSource$(File$)                  'Get source file's name
  147.         Dest$ = SubDir$ + "\" + Mid$(File$, Len(GetSource$(File$)) + 2)  'Get destination file's name
  148.         
  149. '---------------------------------------------------------------
  150. 'Check if file already exist. If so, load Warn form and let user
  151. 'determine overwriting. WarnFlag is boolean to determine, if
  152. 'user has chosen overwrite all files, so installation does not
  153. 'prompt overwriting warning anymore.
  154. '---------------------------------------------------------------
  155.         
  156.         IsFile$ = Dir$(Dest$)
  157.         If IsFile$ = "" Then
  158.             Install.Lbl_List.Caption = "Now copying file " + File$ + " from disk" + Str$(WhichDisk%)
  159.             LZFileCopy Source$, Dest$
  160.             Install.List1.AddItem Dest$
  161.         Else
  162.             Screen.MousePointer = 0
  163.             If WarnFlag = True Then
  164.                 Warn.Lbl_Warn.Caption = "File already exist!, would you like to overwrite it? " + Dest$  'give the user a change to prevent overwriting
  165.                 Warn.Show 1
  166.             Else
  167.                 Install.Lbl_List.Caption = "Now copying file " + File$ + " from disk" + Str$(WhichDisk%)
  168.                 LZFileCopy Source$, Dest$
  169.                 Install.List1.AddItem Dest$
  170.             End If
  171.         End If
  172.     Loop
  173. Screen.MousePointer = 0    'default mousepointer
  174. End Sub
  175.  
  176. Sub IniGrpItem (lpApplication As String, lpKeyName As String, lpDefault As String)
  177.     
  178.     'start loop
  179.     I = 0
  180.     Do
  181.         I = I + 1
  182.         lpKeyName$ = "file" + Str$(I)
  183.         GetStringvar% = GetPrivateProfileString(lpApplication$, lpKeyName$, lpDefault$, FileStr$, nSize%, lpFileName$)
  184.             'Get items command line and after "," in install.inf item's title
  185.         DestFile$ = DestDir$ + "\" + RTrim$(Left$(FileStr$, GetStringvar%))
  186.             'get the item's title
  187.         DestTitle$ = Mid$(DestFile$, (InStr(DestFile$, ",")) + 1, InStr(DestFile$, ";") - InStr(DestFile$, ",") - 1)
  188.             'if you omit the item's title put title from file's name
  189.         If DestTitle$ = "" Then
  190.             DestTitle$ = Mid$(FileStr$, 1, (InStr(FileStr$, ",")) - 1)
  191.         End If
  192.             'get the item's icon
  193.         ItemIcon$ = Mid$(DestFile$, (InStr(DestFile$, ";")) + 1)
  194.             'if you omit the item's icon use default icon
  195.         If Not ItemIcon$ = "" Then
  196.             ItemIcon$ = DestDir$ + "\" + ItemIcon$
  197.         End If
  198.             'get the item's command line
  199.         DestFile$ = Left$(DestFile$, (InStr(DestFile$, ",")) - 1)
  200.         
  201.  
  202.             'check named mark to end loop
  203.         If Left$(FileStr$, 7) = "EndMark" Then
  204.             Exit Do
  205.         ElseIf Left$(FileStr$, 8) = "EndMark" Then
  206.             Exit Do
  207.         End If
  208.        
  209.        For X% = 1 To 10        'Give time for DDE response
  210.            z% = DoEvents()
  211.        Next
  212.        
  213.        Install.Lbl_List.LinkExecute "[AddItem(" + DestFile$ + "," + DestTitle$ + "," + ItemIcon$ + ")]"
  214.     
  215.     Loop
  216.     'Install.Lbl_List.LinkTimeout = 50
  217.     Install.Lbl_List.LinkMode = 0
  218. End Sub
  219.  
  220. Sub LZFileCopy (Source$, Dest$)
  221.  
  222. '---------------------------------------------------------
  223. 'This procedure shows how easily you can use LZexpand.dll
  224. 'WIN 3.1 API function to copy file. It also decompress the
  225. 'file if the file is in compressed mode (if the file was
  226. 'compressed using compress.exe in SDK 3.1). You can remove
  227. 'Print and DoEvents() lines because they only show what
  228. 'is currently happening.
  229. '---------------------------------------------------------
  230.  
  231. '------------------------
  232. 'Declare file structures.
  233. '------------------------
  234.  
  235. Dim lpSrc As OFSTRUCT
  236. Dim lpDst As OFSTRUCT
  237.     
  238.     '---------------------
  239.     'Open the source file.
  240.     '---------------------
  241.     SrcFile% = LZOpenFile(Source$, lpSrc, OF_READ)
  242.     
  243.     '----------------------------
  244.     'Create the destination file.
  245.     '----------------------------
  246.     DstFile% = LZOpenFile(Dest$, lpDst, OF_CREATE)
  247.     
  248.     '---------------------------------------------
  249.     'Copy the source file to the destination file.
  250.     '---------------------------------------------
  251.     DoCopy& = LZCopy(SrcFile%, DstFile%)
  252.     
  253.     '----------------
  254.     'Close the files.
  255.     '----------------
  256.     LZClose SrcFile%
  257.     LZClose DstFile%
  258. End Sub
  259.  
  260.